;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 2003 by Andy Hefner (andy.hefner@verizon.net)

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.


;;; This hack gives you pretty graphical icons in the pointer documentation.

(in-package :clim-internals)


(defparameter *data-mouse-left* '(
#2A((0 0 0 0 0 1 1 1 2 3 4 5 6 7 8 9 10 0 0 0 0 0)
 (0 0 0 11 12 13 14 15 16 17 18 19 20 21 22 22 23 24 25 0 0 0)
 (0 0 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 0 0)
 (0 1 44 45 46 47 48 31 49 19 50 51 19 37 52 53 54 55 41 56 57 0)
 (1 58 59 60 61 62 63 64 65 66 50 19 67 68 41 69 66 70 71 72 73 74)
 (1 75 76 77 78 79 80 81 82 36 83 83 67 68 84 85 85 16 85 86 87 88)
 (89 90 91 92 93 94 95 81 69 50 50 51 67 40 96 97 98 99 100 101 102 103)
 (104 105 106 107 108 109 110 111 112 69 82 113 113 114 115 116 117 41 23 118 102 43)
 (104 119 120 121 122 123 81 31 124 49 17 124 125 21 96 16 86 22 126 127 87 43)
 (128 129 130 121 131 132 65 113 82 53 71 133 69 112 125 41 134 135 136 56 137 25)
 (1 138 139 121 121 140 67 33 121 121 83 36 50 132 141 37 84 142 136 143 144 145)
 (146 52 147 121 121 54 83 121 148 148 121 36 50 67 53 149 116 16 126 87 150 25)
 (151 98 121 121 121 152 83 121 148 148 121 19 51 67 53 65 85 153 22 154 155 25)
 (156 97 157 121 121 55 36 121 148 148 121 33 66 71 82 114 21 41 49 115 56 25)
 (74 115 158 121 159 160 33 121 148 148 121 50 67 133 20 49 96 85 34 66 161 145)
 (162 134 36 34 163 18 66 121 148 148 121 67 164 82 40 85 41 165 121 166 167 43)
 (0 25 96 33 33 70 133 121 148 148 121 168 53 112 49 32 85 169 121 170 171 0)
 (0 25 172 116 17 17 20 121 148 148 121 113 65 124 32 16 124 173 168 174 145 0)
 (0 0 24 142 175 21 98 121 148 148 121 121 121 121 153 38 16 175 136 176 0 0)
 (0 0 176 118 134 170 177 121 148 148 148 148 148 148 121 126 178 179 180 181 0 0)
 (0 0 0 182 183 184 185 121 148 148 148 148 148 148 121 186 187 5 171 0 0 0)
 (0 0 0 0 188 136 189 121 121 121 121 121 121 121 136 143 5 176 0 0 0 0)
 (0 0 0 0 0 190 7 191 135 127 127 189 186 191 73 192 176 0 0 0 0 0)
 (0 0 0 0 0 0 0 8 7 193 193 2 9 190 194 0 0 0 0 0 0 0))

#(0 0 0 163 122 34 81 81 81 86 86 86 89 89 89 91 91 91 90 90 90 85 85 85 82 82
  82 78 78 78 73 73 73 160 119 34 155 113 31 218 139 11 244 147 4 252 150 0 146
  146 146 167 167 167 197 197 197 194 194 194 173 173 173 157 157 157 135 135
  135 132 132 132 71 71 71 63 63 63 153 113 32 206 131 17 222 147 30 238 173 72
  247 157 23 255 152 0 155 155 155 192 192 192 230 230 230 232 232 232 195 195
  195 165 165 165 140 140 140 153 153 153 169 169 169 148 148 148 115 115 115
  61 61 61 209 133 17 226 144 16 244 196 124 250 216 164 250 189 99 163 163 163
  193 193 193 191 191 191 144 144 144 180 180 180 208 208 208 201 201 201 105
  105 105 59 59 59 232 142 7 233 148 17 250 162 29 255 182 71 255 161 25 255
  160 15 255 154 0 170 170 170 190 190 190 188 188 188 168 168 168 176 176 176
  183 183 183 185 185 185 125 125 125 96 96 96 53 53 53 229 144 14 255 165 28
  255 198 53 255 209 58 255 179 23 255 162 1 255 156 0 178 178 178 196 196 196
  150 150 150 159 159 159 141 141 141 106 106 106 56 56 56 162 121 34 224 148
  25 255 196 53 255 255 112 255 255 113 255 201 25 255 169 0 152 152 152 161
  161 161 162 162 162 147 147 147 134 134 134 124 124 124 107 107 107 58 58 58
  157 117 33 240 164 36 255 249 105 255 255 201 255 255 157 255 197 16 255 166
  0 255 153 0 171 171 171 174 174 174 166 166 166 154 154 154 158 158 158 156
  156 156 120 120 120 255 177 40 255 255 166 255 255 255 255 255 198 255 176 7
  164 164 164 160 160 160 126 126 126 119 119 119 160 119 33 255 182 24 255 255
  203 255 255 219 186 186 186 182 182 182 137 137 137 122 122 122 113 113 113
  102 102 102 255 179 0 255 255 248 202 202 202 177 177 177 130 130 130 98 98
  98 92 92 92 64 64 64 48 48 48 247 247 247 211 137 0 172 172 172 99 99 99 50
  50 50 205 205 205 145 145 145 123 123 123 100 100 100 49 49 49 240 240 240
  220 220 220 239 239 239 199 199 199 112 112 112 54 54 54 221 221 221 184 184
  184 179 179 179 175 175 175 95 95 95 181 181 181 215 215 215 143 143 143 68
  68 68 131 131 131 229 229 229 101 101 101 149 149 149 70 70 70 151 151 151
  121 121 121 111 111 111 88 88 88 65 65 65 75 75 75 118 118 118 133 133 133
  139 139 139 114 114 114 109 109 109 80 80 80 117 117 117 79 79 79 110 110 110
  77 77 77 83 83 83 74 74 74)))


(defparameter *data-mouse-middle* '(
#2A((0 0 0 0 0 1 2 3 3 3 3 3 3 3 3 4 5 0 0 0 0 0)
  (0 0 0 6 7 8 9 10 10 11 12 13 10 10 10 14 15 16 1 0 0 0)
  (0 0 17 18 19 20 21 22 22 23 24 25 26 22 22 27 28 29 30 31 0 0)
  (0 32 18 33 34 35 36 22 22 37 38 39 40 41 41 42 43 44 29 45 7 0)
  (32 46 47 48 49 50 51 52 22 53 53 53 53 22 41 54 55 56 57 58 59 17)
  (32 9 60 42 61 62 63 64 22 53 53 53 53 22 22 65 65 66 65 19 67 68)
  (69 70 71 72 73 74 62 75 22 53 53 53 53 22 22 76 77 48 70 8 78 79)
  (80 48 81 73 73 82 36 83 22 53 53 53 53 22 22 84 85 29 15 86 78 31)
  (69 87 73 73 73 62 88 22 22 22 22 22 22 22 22 66 19 14 9 89 67 31)
  (32 84 73 73 90 91 88 50 92 42 57 63 54 93 87 29 94 95 96 45 97 1)
  (32 48 98 73 73 99 100 36 101 102 102 103 34 91 101 104 105 33 96 106 107 108)
  (32 109 110 73 73 43 102 101 111 112 102 103 34 101 111 112 84 66 9 67 113 1)
  (114 77 73 73 73 115 101 111 112 111 112 116 101 111 112 111 112 117 14 118 119 1)
  (120 76 121 73 73 44 101 111 101 111 112 36 101 111 101 111 112 29 122 21 45 1)
  (17 21 123 73 124 125 126 111 101 111 112 34 101 111 101 111 112 65 74 55 127 108)
  (128 94 103 74 129 130 131 112 55 101 111 101 111 112 28 101 111 132 73 133 134 31)
  (0 1 135 36 36 136 111 112 137 101 111 101 111 112 122 101 138 139 73 60 140 0)
  (0 1 47 84 51 141 111 112 92 92 101 111 112 142 143 126 144 73 145 146 108 0)
  (0 0 16 33 147 101 111 112 51 148 101 111 112 143 117 149 150 151 96 152 0 0)
  (0 0 152 86 94 112 111 112 143 84 101 111 112 60 15 126 153 154 155 156 0 0)
  (0 0 0 157 158 159 112 19 60 109 60 112 14 15 118 18 112 160 140 0 0 0)
  (0 0 0 0 161 96 162 163 33 33 33 164 8 89 96 106 160 152 0 0 0 0)
  (0 0 0 0 0 165 166 167 95 89 89 162 18 167 59 168 152 0 0 0 0 0)
  (0 0 0 0 0 0 0 169 166 170 170 171 4 165 172 0 0 0 0 0 0 0))

#(3 3 3 63 63 63 69 69 69 15 127 219 78 78 78 73 73 73 55 55 55 59 59 59 124
  124 124 126 126 126 37 145 247 39 146 247 104 179 249 93 173 249 135 135 135
  132 132 132 71 71 71 53 53 53 114 114 114 141 141 141 172 172 172 154 154 154
  68 158 255 111 180 255 190 221 255 195 224 255 106 177 255 153 153 153 169
  169 169 148 148 148 115 115 115 61 61 61 48 48 48 130 130 130 193 193 193 218
  218 218 192 192 192 98 173 255 81 164 255 79 163 255 94 171 255 69 158 255
  180 180 180 208 208 208 201 201 201 105 105 105 111 111 111 131 131 131 147
  147 147 179 179 179 174 174 174 167 167 167 69 160 255 43 166 255 176 176 176
  190 190 190 183 183 183 185 185 185 125 125 125 96 96 96 143 143 143 203 203
  203 197 197 197 182 182 182 70 163 255 159 159 159 146 146 146 106 106 106 56
  56 56 47 47 47 134 134 134 173 173 173 235 235 235 255 255 255 230 230 230 69
  162 255 161 161 161 162 162 162 107 107 107 58 58 58 46 46 46 211 211 211 229
  229 229 68 159 255 158 158 158 156 156 156 120 120 120 160 160 160 170 170
  170 119 119 119 254 254 254 186 186 186 178 178 178 171 171 171 137 137 137
  122 122 122 113 113 113 102 102 102 234 234 234 202 202 202 188 188 188 193
  210 255 196 196 196 195 195 195 165 165 165 150 150 150 98 98 98 92 92 92 64
  64 64 144 144 144 247 247 247 50 125 255 150 183 255 99 99 99 50 50 50 205
  205 205 194 194 194 145 145 145 123 123 123 100 100 100 49 49 49 240 240 240
  163 163 163 220 220 220 239 239 239 199 199 199 194 211 255 112 112 112 54 54
  54 221 221 221 209 227 255 50 126 255 198 242 255 175 175 175 95 95 95 152
  152 152 202 220 255 187 187 187 56 141 255 252 255 255 68 68 68 195 212 255
  164 164 164 155 155 155 61 154 255 181 181 181 101 101 101 149 149 149 168
  168 168 197 215 255 58 145 255 196 240 255 70 70 70 52 130 255 156 191 255 88
  88 88 65 65 65 75 75 75 118 118 118 133 133 133 91 91 91 80 80 80 117 117 117
  129 129 129 127 127 127 79 79 79 85 85 85 110 110 110 77 77 77 82 82 82 83 83
  83 81 81 81 74 74 74)))

(defparameter *data-mouse-right* '(
#2A((0 0 0 0 0 1 2 3 4 5 6 7 8 9 10 10 10 0 0 0 0 0)
 (0 0 0 11 12 13 14 15 16 17 18 19 20 21 22 22 22 10 10 0 0 0)
 (0 0 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 10 0 0)
 (0 40 24 41 42 43 30 44 45 19 42 46 19 34 47 48 49 50 51 52 10 0)
 (40 53 54 44 55 56 17 29 57 58 42 19 59 60 61 62 63 64 65 66 39 10)
 (40 14 67 68 69 18 70 34 71 33 72 72 59 60 73 74 75 76 77 78 39 10)
 (79 80 20 81 82 31 18 17 83 42 42 46 59 84 73 85 86 87 88 89 90 10)
 (91 44 92 82 82 93 30 34 94 83 71 56 56 95 73 73 96 97 98 99 90 10)
 (79 100 82 82 82 18 57 34 101 45 17 101 100 21 73 73 102 103 104 105 106 10)
 (40 107 82 82 108 109 57 56 71 68 110 70 83 94 100 111 73 73 112 89 39 10)
 (40 44 113 82 82 114 59 115 115 115 115 115 115 115 116 34 117 41 35 22 39 10)
 (40 118 119 82 82 120 72 115 10 10 10 10 10 10 115 26 107 16 14 121 122 1)
 (123 124 82 82 82 125 72 115 10 10 10 10 10 10 10 115 126 127 128 129 130 1)
 (131 132 133 82 82 134 33 115 10 10 115 115 115 10 10 115 21 111 45 27 135 1)
 (23 27 136 82 137 138 30 115 10 10 115 115 115 10 10 115 139 126 31 58 140 141)
 (142 143 33 31 144 18 58 115 10 10 10 10 10 10 10 115 111 55 82 145 146 147)
 (0 1 139 30 30 148 70 115 10 10 10 10 10 10 115 29 126 149 82 67 150 0)
 (0 1 54 107 17 17 20 115 10 10 10 10 10 115 29 16 101 93 151 152 141 0)
 (0 0 153 41 154 21 124 115 10 10 115 10 10 10 115 155 16 154 156 157 0 0)
 (0 0 157 158 143 67 159 115 10 10 115 115 10 10 10 160 161 53 162 163 0 0)
 (0 0 0 3 164 165 28 115 10 10 115 155 115 10 10 115 166 7 150 0 0 0)
 (0 0 0 0 167 156 168 115 115 115 115 15 13 115 115 115 7 157 0 0 0 0)
 (0 0 0 0 0 169 9 170 171 172 172 168 24 170 173 174 157 0 0 0 0 0)
 (0 0 0 0 0 0 0 175 9 176 176 4 177 169 178 0 0 0 0 0 0 0))

#(3 3 3 63 63 63 69 69 69 75 75 75 81 81 81 86 86 86 89 89 89 91 91 91 90 90 90
  85 85 85 90 6 216 55 55 55 59 59 59 124 124 124 126 126 126 127 127 127 146
  146 146 167 167 167 197 197 197 194 194 194 173 173 173 157 157 157 136 57
  255 53 53 53 114 114 114 141 141 141 172 172 172 154 154 154 139 139 139 155
  155 155 192 192 192 230 230 230 232 232 232 195 195 195 165 165 165 143 45
  255 147 53 255 157 93 255 147 75 255 114 20 255 48 48 48 130 130 130 193 193
  193 218 218 218 147 147 147 163 163 163 191 191 191 143 52 254 175 110 253
  202 160 254 198 159 255 143 67 254 112 23 246 111 111 111 131 131 131 179 179
  179 174 174 174 170 170 170 190 190 190 188 188 188 168 168 168 145 62 253
  168 102 252 180 122 253 180 124 253 185 139 253 126 41 255 143 143 143 180
  180 180 203 203 203 182 182 182 178 178 178 196 196 196 153 92 255 151 86 253
  147 67 253 141 56 253 162 99 254 149 81 254 47 47 47 134 134 134 235 235 235
  255 255 255 176 176 176 169 169 169 153 91 255 152 82 255 144 62 255 141 58
  255 136 56 255 115 21 255 46 46 46 211 211 211 229 229 229 171 171 171 166
  166 166 153 88 255 148 74 255 141 57 255 132 47 255 160 160 160 164 164 164
  151 91 253 150 85 255 143 55 255 133 51 255 114 21 255 158 158 158 254 254
  254 186 186 186 185 185 185 148 148 148 143 51 254 234 234 234 202 202 202
  220 202 247 177 177 177 150 150 150 144 144 144 247 247 247 208 208 208 106
  106 106 99 99 99 50 50 50 162 162 162 205 205 205 159 159 159 145 145 145 135
  135 135 123 123 123 100 100 100 49 49 49 161 161 161 240 240 240 201 201 201
  105 105 105 220 220 220 239 239 239 199 199 199 152 152 152 112 112 112 64 64
  64 54 54 54 137 137 137 221 221 221 175 175 175 95 95 95 61 61 61 183 183 183
  215 215 215 68 68 68 181 181 181 101 101 101 71 71 71 149 149 149 140 140 140
  113 113 113 70 70 70 120 120 120 151 151 151 221 203 248 121 121 121 88 88 88
  65 65 65 118 118 118 133 133 133 109 109 109 80 80 80 117 117 117 79 79 79
  110 110 110 122 122 122 119 119 119 96 96 96 77 77 77 82 82 82 83 83 83 78 78
  78 74 74 74)))   

   

  


(defun kludge-design (data)
  (let* ((colormap (second data))
	 (designs (make-array (/ (length colormap ) 3))))
    (loop for i from 0 below (/ (length colormap) 3)
      do (setf (aref designs i) (make-rgb-color (/ (aref colormap (+ 0 (* i 3))) 256.0)
						(/ (aref colormap (+ 1 (* i 3))) 256.0)
						(/ (aref colormap (+ 2 (* i 3))) 256.0))))
  (make-pattern (first data) designs)))


(defparameter *icon-mouse-left* (kludge-design *data-mouse-left*))
(defparameter *icon-mouse-middle* (kludge-design *data-mouse-middle*))
(defparameter *icon-mouse-right* (kludge-design *data-mouse-right*))




(defmethod frame-print-pointer-documentation
    ((frame standard-application-frame) input-context stream state event)
  (unless state
    (return-from frame-print-pointer-documentation nil))
  (destructuring-bind (current-modifier new-translators)
      state
    (let ((x (device-event-x event))
	  (y (device-event-y event))
	  (pstream *pointer-documentation-output*))
      (if (null new-translators)
          (when (and (background-message pstream)
                     (not (record-on-display pstream (background-message pstream))))
            (cond ((> (get-universal-time)
                      (+ (background-message-time pstream)
                         *background-message-minimum-lifetime*))
                   (setf (background-message pstream) nil))
                  (t
                   (setf (output-record-parent (background-message pstream)) nil)
                   (stream-add-output-record pstream (background-message pstream))
                   (replay (background-message pstream) pstream))))
          (loop for (button presentation translator context)
                in new-translators
                for name = (cadr (assoc button +button-documentation+))
                for first-one = t then nil
                do (progn
                     (unless first-one
                       (stream-increment-cursor-position pstream 12 0)
                       #+nil(write-string "; " pstream))
                     (unless (zerop current-modifier)
                       (print-modifiers pstream current-modifier :short)
                       (write-string "-" pstream))

                     ;; Hefner's pointer-documentation hack.
                     (setf name (cond 
                                  ((eql button +pointer-left-button+)   *icon-mouse-left*)
                                  ((eql button +pointer-middle-button+) *icon-mouse-middle*)
                                  ((eql button +pointer-right-button+)  *icon-mouse-right*)
                                  (t name)))
                     (if (not (typep name 'indexed-pattern))  (format pstream "~A: " name)
                         (multiple-value-bind (x y)  (stream-cursor-position pstream)
                           (draw-pattern* pstream name x y)
                           (stream-increment-cursor-position pstream 24 0)))
           	   
                     (document-presentation-translator translator
                                                       presentation
                                                       (input-context-type context)
                                                       *application-frame*
                                                       event
                                                       stream
                                                       x y
                                                       :stream pstream
                                                       :documentation-type
                                                       :pointer))   ))
                                        ;finally nil #+nil (when new-translators
                                        ;		(write-char #\. pstream)))
      ;; Wasteful to do this after doing
      ;; find-innermost-presentation-context above... look at doing this
      ;; first and then doing the innermost test.
      (let ((all-translators (find-applicable-translators
			      (stream-output-history stream)
			      input-context
			      *application-frame*
			      stream
			      x y
			      :for-menu t))
	    (other-modifiers nil))
	(loop for (translator) in all-translators
	      for gesture = (gesture translator)
	      unless (eq gesture t)
	      do (loop for (name type modifier) in gesture
		       unless (eql modifier current-modifier)
		       do (pushnew modifier other-modifiers)))
	(when other-modifiers
	  (setf other-modifiers (sort other-modifiers #'cmp-modifiers))
	  (terpri pstream)
	  (write-string "To see other commands, press "	pstream)
	  (loop for modifier-tail on other-modifiers
		for (modifier) = modifier-tail
		for count from 0
		do (progn
		     (if (null (cdr modifier-tail))
			 (progn
			   (when (> count 1)
			     (write-char #\, pstream))
			   (when (> count 0)
			     (write-string " or " pstream)))
			 (when (> count 0)
			   (write-string ", " pstream)))
		     (print-modifiers pstream modifier :long)))
	  (write-char #\. pstream))))))
